Practices over Time
Anwesha Guha
2024-10-10
Also see core-practices-over-time.html.
dat <- import(here("data/longitudinal", "full-tags-wide.csv"))
dictionary <- import(here("data/2024 data", "dictionary_2024.csv"))
clean_labels <- import(here("data/longitudinal", "tag-labels.csv"))
source(here("scripts/branding.R"))Which core practices have been implemented most over time?
core_prac <- dat %>%
select(school_id, year, starts_with("core")) %>%
mutate(school_id = as.factor(school_id),
year = as.factor(year))
core_prac[is.na(core_prac)] <- 0
core_prac <- core_prac %>%
# summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(starts_with("core"),
names_to = "core_practice",
values_to = "times_selected")
core_prac_dat <- core_prac %>%
group_by(core_practice) %>%
summarise(selected = sum(times_selected)) %>%
arrange(-selected)First note: there are 26 practices that have never been selected as a core practice. They are the following:
no_core <- core_prac_dat %>%
filter(selected == 0) %>%
mutate(core_practice = sub("core_", "", core_practice)) %>%
pull(core_practice)
no_core## [1] "alternating_days" "assessment_schedule"
## [3] "data_instruction" "design_margins"
## [5] "devices_home" "ell_supports"
## [7] "equity_plan" "experiential"
## [9] "flexible_schedule" "graduation_supports"
## [11] "half_days" "hiring_practices"
## [13] "immigrants_supports" "information_formats"
## [15] "lab_rotation" "learner_agency"
## [17] "local_global" "maker"
## [19] "measures_climate" "measures_college"
## [21] "measures_purpose" "oer"
## [23] "other_leaders" "poverty_supports"
## [25] "print_materials" "quality_materials"
## [27] "relevant_learning" "rigorous_coursework"
## [29] "sel_plan" "staffing_infrastructure"
## [31] "teachers_choose_modality" "wraparound"These are the rest.
datatable(core_prac_dat)Let’s look more closely at the top 10 on this list.
top_core <- core_prac_dat %>%
head(10) %>%
pull(core_practice)
top_core_dat <- core_prac %>%
filter(core_practice %in% top_core) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected))top_core_dat %>%
filter(year != 2019) %>%
ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) 
It looks like 2021 was really driving the top core practices list across the years. Is that true?
Update – look more closely at tag sample
full_tags_long <- import(here("data/longitudinal/full-tags-long.csv"))tags_2019 <- full_tags_long %>%
filter(year == 2019) %>%
group_by(var) %>%
summarise(`2019` = sum(usage), .groups = "drop") #173 schools
tags_2021 <- full_tags_long %>%
filter(year == 2021) %>%
group_by(var) %>%
summarise(`2021` = sum(usage), .groups = "drop") #232 schools
tags_2022 <- full_tags_long %>%
filter(year == 2022) %>%
group_by(var) %>%
summarise(`2022` = sum(usage), .groups = "drop") #161 schools
tags_2023 <- full_tags_long %>%
filter(year == 2023) %>%
group_by(var) %>%
summarise(`2023` = sum(usage), .groups = "drop") #251 schools
tags_2024 <- full_tags_long %>%
filter(year == 2024) %>%
group_by(var) %>%
summarise(`2024` = sum(usage), .groups = "drop") #189 schools# Create a dataframe with variables and their years
tags_list <- list(
`2019` = tags_2019 %>% pull(var) %>% unique(),
`2021` = tags_2021 %>% pull(var) %>% unique(),
`2022` = tags_2022 %>% pull(var) %>% unique(),
`2023` = tags_2023 %>% pull(var) %>% unique(),
`2024` = tags_2024 %>% pull(var) %>% unique()
)
# Combine the list into a long dataframe
tags_df <- bind_rows(
lapply(names(tags_list), function(year) {
data.frame(variable = tags_list[[year]], year = as.integer(year))
})
)
# Summarize the number of years each variable is used and list the years used
variable_usage <- tags_df %>%
group_by(variable) %>%
summarise(
number_of_years_used = n_distinct(year),
years_used = paste(sort(unique(year)), collapse = ", ")
)Now, let’s look more closely at the tags that have never been selected as core.
variable_usage %>%
mutate(variable = sub("practices_", "", variable)) %>%
filter(variable %in% no_core) %>%
datatable()Looks like all are from 2019 except other_leaders, which
is from 2023.
Here is the rest of them.
variable_usage %>%
mutate(variable = sub("practices_", "", variable)) %>%
filter(!variable %in% no_core) %>%
datatable()Update for Aug 2
I want to look at the top 10 core practices by year implemented stacked bar chart by also looking at the years the tag was offered.
top_core_dat <- top_core_dat %>%
mutate(core_practice = gsub("core_", "", core_practice))
top_by_use <- variable_usage %>%
mutate(variable = gsub("practices_", "", variable)) %>%
right_join(., top_core_dat, by = c("variable" = "core_practice"))
total_select <- top_by_use %>%
group_by(variable) %>%
summarise(total_select = sum(selected)) %>%
ungroup()
top_by_use <- left_join(top_by_use, total_select)tag_labels <- import(here("data/longitudinal", "tag-labels.csv"))
top_by_use %>%
filter(year != 2019) %>%
left_join(., tag_labels) %>%
ggplot() +
geom_text(aes(label = years_used, x = label, y = total_select + 2), hjust = 0, size = 5, color = "gray") +
geom_col(aes(reorder(label, selected), selected, fill = year)) +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), limits = c(0, 342)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 20),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) 
top_by_use %>%
left_join(., tag_labels) %>%
select(label, number_of_years_used, years_used, year, selected, total_select) %>%
datatable()Also update core practices by number of years that tags were implemented
# times practices are selected each year needed for sorting
core_prac_dat <- core_prac_dat %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
rename(times_selected = selected)
core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., variable_usage, by = c("core_practice" = "variable")) %>%
filter(year != 2019) %>%
left_join(., core_prac_dat) %>%
select(-years_used) %>%
arrange(-times_selected) %>%
group_by(core_practice) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(number_of_years_used > 4) %>%
filter(times_selected > 104) %>%
ggplot() +
geom_col(aes(reorder(label, times_selected), selected, fill = year)) +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Most selected core practices (4+ years)",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
# text = element_text(size = 20),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) 
core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., variable_usage, by = c("core_practice" = "variable")) %>%
filter(year != 2019) %>%
left_join(., core_prac_dat) %>%
select(-years_used) %>%
arrange(-times_selected) %>%
group_by(core_practice) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(number_of_years_used > 4) %>%
filter(times_selected > 104) %>%
mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>%
ggplot() +
geom_col(aes(reorder(label, times_selected), selected, fill = year), position = "dodge") +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
labs(title = "Most selected core practices (4+ years)",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 9),
axis.text.x = element_text()) +
theme(
panel.grid.major.x = element_blank(),
legend.position = "bottom"
) 
Update for 8/9
n_2019 <- 173
n_2021 <- 232
n_2022 <- 161
n_2023 <- 251
n_2024 <- 189
core_prac_plot_dat <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., variable_usage, by = c("core_practice" = "variable")) %>%
filter(year != 2019) %>%
left_join(., core_prac_dat) %>%
select(-years_used) %>%
arrange(-times_selected) %>%
group_by(core_practice) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(number_of_years_used > 4) %>%
mutate(pct = case_when(year == 2021 ~ selected/n_2021,
year == 2022 ~ selected/n_2022,
year == 2023 ~ selected/n_2023,
year == 2024 ~ selected/n_2024)) %>%
group_by(year) %>%
arrange(year, desc(pct)) %>%
slice_max(pct, n = 10) %>%
ungroup()
core_prac_plot_dat %>%
mutate(label = reorder_within(label, pct, year)) %>%
ggplot(aes(label, pct, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
facet_wrap(~year, scales = "free_y") + #, axes = "all"
labs(title = "Most selected core practices (4+ years)",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 8),
panel.grid.major.y = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1),
strip.placement = "outside") +
coord_flip() +
tidytext::scale_x_reordered()
core_prac_plot_dat %>%
mutate(label = reorder_within(label, pct, year)) %>%
ggplot(aes(label, pct, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
labs(title = "Most selected core practices (4+ years)",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 8),
panel.grid.major.y = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1),
strip.placement = "outside") +
scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
tidytext::scale_x_reordered()
core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., variable_usage, by = c("core_practice" = "variable")) %>%
filter(year != 2019) %>%
left_join(., core_prac_dat) %>%
select(-years_used) %>%
arrange(-times_selected) %>%
group_by(core_practice) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(number_of_years_used > 4) %>%
filter(times_selected > 104) %>%
mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>%
mutate(pct = case_when(year == 2021 ~ selected/n_2021,
year == 2022 ~ selected/n_2022,
year == 2023 ~ selected/n_2023,
year == 2024 ~ selected/n_2024)) %>%
ggplot() +
geom_col(aes(reorder(label, times_selected), pct, fill = year), position = "dodge") +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), limits = c(0, .8), labels = scales::percent) +
scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
labs(title = "Most selected core practices",
subtitle = "These core practices have been around for at least 4 years.",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 9),
axis.text.x = element_text()) +
theme(
panel.grid.major.x = element_blank(),
legend.position = "bottom"
) 
core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., variable_usage, by = c("core_practice" = "variable")) %>%
filter(year != 2019) %>%
left_join(., core_prac_dat) %>%
select(-years_used) %>%
arrange(-times_selected) %>%
group_by(core_practice) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(number_of_years_used > 4) %>%
filter(times_selected > 139) %>%
mutate(label = ifelse(label == "competency/mastery-based education", "competency/ mastery-based education", label)) %>%
mutate(pct = case_when(year == 2021 ~ selected/n_2021,
year == 2022 ~ selected/n_2022,
year == 2023 ~ selected/n_2023,
year == 2024 ~ selected/n_2024)) %>%
ggplot() +
geom_col(aes(reorder(label, times_selected), pct, fill = year), position = "dodge") +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), limits = c(0, .8), labels = scales::percent) +
scale_x_discrete(labels = scales::label_wrap(10), guide = guide_axis(n.dodge = 1)) +
labs(title = "Most selected core practices",
subtitle = "These core practices have been around for at least 4 years.",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 9),
axis.text.x = element_text()) +
theme(
panel.grid.major.x = element_blank(),
legend.position = "bottom"
) 
And without 2021 year
core_prac_plot_dat %>%
filter(year != 2021) %>%
mutate(label = reorder_within(label, pct, year)) %>%
ggplot(aes(label, pct, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0), labels = scales::percent_format()) +
facet_wrap(~year, scales = "free_y") + #, axes = "all"
labs(title = "Most selected core practices (4+ years)",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
panel.grid.major.y = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1),
strip.placement = "outside") +
coord_flip() +
tidytext::scale_x_reordered()
Have any lost popularity over the last 5 years?
Well, this is an interesting question given that 2021 seems like it was the year that schools were more liberal with their core practice selections, so I imagine this affects most practices. But let’s look at them below.
p <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, selected, color = core_practice)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("core_practice", "selected"))Update – tag count breakdown by year
variable_usage_by_year <- tags_2019 %>%
full_join(tags_2021, by = "var") %>%
full_join(tags_2022, by = "var") %>%
full_join(tags_2023, by = "var") %>%
full_join(tags_2024, by = "var") %>%
left_join(clean_labels, by = c("var" = "variable"))variable_usage_by_year %>%
select(label, everything(), -var) %>%
mutate(total = rowSums(select(.,`2019`:`2024`), na.rm = TRUE)) %>%
datatable()Filter to tags that have been used at least 4 years.
vars_4plus <- variable_usage %>% filter(number_of_years_used >= 4) %>% pull(variable)
variable_usage_by_year %>%
filter(var %in% vars_4plus) %>%
select(label, everything(), -var) %>%
mutate(total = rowSums(select(.,`2019`:`2024`), na.rm = TRUE)) %>%
datatable()Which are the oldest stable core tags and newest growing tags?
stable_prac <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
group_by(core_practice) %>%
summarise(
min_selected = min(selected, na.rm = TRUE),
max_selected = max(selected, na.rm = TRUE),
range_selected = max_selected - min_selected
) %>%
filter(range_selected <= 50) %>%
pull(core_practice)
p <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
filter(core_practice %in% stable_prac) %>%
filter(selected > 20) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, selected, color = core_practice)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Stable Tags (Selected >20, varied <50)",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("core_practice", "selected"))For newest growing tags, in my first pass, I am going to filter the practices to those that increased between 2022 and 2024. I’m omitting 2021 for the filter.
increased_prac <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(change = year_2024 - year_2022) %>%
filter(change > 0) %>%
arrange(desc(change)) %>%
pull(core_practice)
p <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
filter(core_practice %in% increased_prac) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, selected, color = core_practice)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Tags Increasing since 2022",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("core_practice", "selected"))core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
filter(year != 2021) %>%
filter(core_practice %in% increased_prac) %>%
ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Practices Increasing in Selection Since 2022",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
)
What about those with the largest change?
core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(change = year_2024 - year_2022) %>%
filter(change > 0) %>%
arrange(desc(change)) %>%
head(10) %>%
ggplot(aes(x = year_2022, xend = year_2024, y = reorder(core_practice, change), yend = core_practice)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = year_2022), color = "red") +
geom_point(aes(x = year_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (year_2022 + year_2024)/2 -1, label = paste("Δ =", year_2024 - year_2022), color = factor(sign(year_2024 - year_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Core Practice",
x = "Times Selected",
title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools"
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
)
Update for Aug 2
n_2019 <- 173
n_2021 <- 232
n_2022 <- 161
n_2023 <- 251
n_2024 <- 189
var_prop_use <- variable_usage_by_year %>%
select(label, everything(), -var) %>%
mutate(prop_2019 = `2019`/n_2019,
prop_2021 = `2021`/n_2021,
prop_2022 = `2022`/n_2022,
prop_2023 = `2023`/n_2023,
prop_2024 = `2024`/n_2024)
stable_var_prop <- var_prop_use %>%
select(label, starts_with("prop")) %>%
pivot_longer(cols = starts_with("prop"),
names_to = "year",
values_to = "prop",
names_prefix = "prop_") %>%
group_by(label) %>%
summarise(
min_prop = min(prop, na.rm = TRUE),
max_prop = max(prop, na.rm = TRUE),
range_prop = max_prop - min_prop
) %>%
filter(range_prop < .1) %>%
filter(range_prop > 0) %>%
pull(label)
p <- var_prop_use %>%
select(label, starts_with("prop")) %>%
pivot_longer(cols = starts_with("prop"),
names_to = "year",
values_to = "prop",
names_prefix = "prop_") %>%
group_by(label, year) %>%
filter(label %in% stable_var_prop) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, prop, color = label)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Stable Tags (varied < 10%)",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("label", "prop"))Now let’s look at tags that have been growing for the last 2 years.
p <- var_prop_use %>%
select(label, starts_with("prop")) %>%
mutate(growth = prop_2024 - prop_2022) %>%
filter(growth > 0) %>%
select(-growth) %>%
pivot_longer(cols = starts_with("prop"),
names_to = "year",
values_to = "prop",
names_prefix = "prop_") %>%
filter(year != 2019) %>%
filter(year != 2021) %>%
mutate(year = as.integer(year)) %>%
ggplot(aes(year, prop, color = label)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Tags Growing since 2022",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("label", "prop"))Look more closely at additions: within schools, these are the tags that have been most frequently added in the last two years.
growing_tags <- var_prop_use %>%
select(label, starts_with("prop")) %>%
mutate(growth = prop_2024 - prop_2022) %>%
filter(growth > 0) %>%
select(-growth) %>%
pivot_longer(cols = starts_with("prop"),
names_to = "year",
values_to = "prop",
names_prefix = "prop_") %>%
filter(year != 2019) %>%
filter(year != 2021) %>%
group_by(label) %>%
summarize(n = n()) %>%
pull(label)
full_tags_long %>%
select(-core, -time) %>%
filter(year != 2021) %>%
filter(year != 2019) %>%
pivot_wider(names_from = "year",
values_from = "usage") %>%
left_join(clean_labels, by = c("var" = "variable")) %>%
select(-var) %>%
filter(label %in% growing_tags) %>%
mutate(added = `2024` - `2022`) %>%
filter(added >0) %>%
group_by(label) %>%
summarise(schools_added = sum(added)) %>%
arrange(-schools_added) %>%
head(10) %>%
ggplot(aes(reorder(label, schools_added), schools_added)) +
geom_col(fill = transcend_cols[2]) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Tags Added by Schools in the Last Two Years",
x = "",
y = "") +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 9),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
) +
coord_flip()
Largest change graph redone with percentages:
Increase –
core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(change > 0) %>%
arrange(desc(change)) %>%
head(10) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Core Practice",
x = "%Times Selected",
title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools"
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
)
Decrease –
core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(year_2024 > 0) %>%
filter(change < 0) %>%
arrange(change) %>%
head(10) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Core Practice",
x = "%Times Selected",
title = "Core Practices with largest decrease \nfrom 2022 to 2024 Across Schools"
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
)
Restrict to tags available for all of these years.
used_22_24 <- variable_usage_by_year %>%
select(label, `2022`, `2023`, `2024`) %>%
remove_missing() %>%
pull(label)
core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(year_2024 > 0) %>%
filter(change < 0) %>%
arrange(change) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(label %in% used_22_24) %>%
head(10) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Core Practice",
x = "%Times Selected",
title = "Core Practices with largest decrease \nfrom 2022 to 2024 Across Schools",
subtitle = "Tags were available for selection all years."
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
)
core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(change > 0) %>%
arrange(desc(change)) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(label %in% used_22_24) %>%
head(10) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Core Practice",
x = "%Times Selected",
title = "Core Practices with largest increase \nfrom 2022 to 2024 Across Schools",
subtitle = "Tags were available for selection all years."
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
)
### Update for 8/9
increase_plot <- core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(change > 0) %>%
arrange(desc(change)) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(label %in% used_22_24) %>%
head(5) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Increase",
x = ""
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6)),
axis.text.x = element_blank()
) +
scale_x_continuous(labels = scales::percent_format(scale = 1), limits = c(0, 28)) +
scale_y_discrete(labels = scales::label_wrap(30))
decrease_plot <- core_prac %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year %in% c(2022, 2024)) %>%
pivot_wider(names_from = year, values_from = selected, names_prefix = "year_") %>%
mutate(prop_2022 = (year_2022/n_2022)*100,
prop_2024 = (year_2024/n_2024)*100,
change = prop_2024 - prop_2022) %>%
filter(year_2024 > 0) %>%
filter(change < 0) %>%
arrange(change) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
filter(label %in% used_22_24) %>%
head(5) %>%
ggplot(aes(x = prop_2022, xend = prop_2024, y = reorder(label, -change), yend = label)) +
geom_segment(color = "black", linetype = "dotted") +
geom_point(aes(x = prop_2022), color = "red") +
geom_point(aes(x = prop_2024), color = "blue") +
guides(col = guide_legend(nrow = 1, title = NULL)) +
geom_text(
aes(x = (prop_2022 + prop_2024)/2 -1, label = paste0("Δ = ", round(prop_2024 - prop_2022), "%"), color = factor(sign(prop_2024 - prop_2022))),
nudge_y = .3,
hjust = 0,
show.legend = FALSE
) +
labs(
y = "Decrease",
x = "Percentage of Canopy Schools"
) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_text(size = rel(0.6))
) +
scale_x_continuous(labels = scales::percent_format(scale = 1), limits = c(0, 28)) +
scale_y_discrete(labels = scales::label_wrap(30))
increase_plot
decrease_plot
library(patchwork)
increase_plot + decrease_plot + plot_layout(ncol = 1) + plot_annotation(title = "Core Practices with Largest Increase/Decrease",
subtitle = "These tags increased or decreased between 2022 and 2024 across schools.",
theme = theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)))
What is the relationship between core practices most implemented over time and practices on the horizon?
Are we seeing a lot of “brand new” practices piloted, are schools more or less trying out “established” practices, or both?
load(here("data/2024 data", "complete_canopy_2024.RData"))
old_clusters <- import(here("data/clusters_through_2024.csv"))pilot_prac <- tags %>%
select(starts_with("pilot")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N",
names_prefix = "pilot_") %>%
group_by(practice) %>%
summarise(selected = sum(N))These are the practices by time implemented:
implementation_time <- tags %>%
select(starts_with("time_")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N") %>%
mutate(`Not sure` = case_when(N == "Not sure" ~ 1,
TRUE ~ 0),
`Less than a year` = case_when(N == "Less than a year" ~ 1,
TRUE ~ 0),
`1-2 years` = case_when(N == "1-2 years" ~ 1,
TRUE ~ 0),
`3-4 years` = case_when(N == "3-4 years" ~ 1,
TRUE ~ 0),
`5+ years` = case_when(N == "5+ years" ~ 1,
TRUE ~ 0),
practice = sub("time_", "", practice)) %>%
select(!N) %>%
group_by(practice) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE)))
# Plot dat setup
implementation_time_plot <- implementation_time %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
# Practice axes setup
cluster_colors <- unique(old_clusters$cluster) %>%
setNames(object = c(transcend_cols2[c(1, 2, 4, 5)], "#000000"))
clusters <- old_clusters %>%
mutate(practice = sub("practices_", "", var)) %>%
select(-var)
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
# Plot (referenced Gregor's code)
ggplot(implementation_with_color, aes(reorder(practice, N), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)
time_pilot <- left_join(implementation_time, pilot_prac)Now let’s sort by pilot practice selection (descending).
# Plot dat setup
implementation_time_plot <- time_pilot %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
ggplot(implementation_with_color, aes(reorder(practice, selected), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented, From Most to Least Selected to Pilot",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)
Update for Aug 2
implementation_with_color %>%
group_by(cluster, time) %>%
summarise(total = sum(N))## # A tibble: 20 × 3
## # Groups: cluster [5]
## cluster time total
## <chr> <fct> <dbl>
## 1 Deeper learning Less than a year 7
## 2 Deeper learning 1-2 years 28
## 3 Deeper learning 3-4 years 50
## 4 Deeper learning 5+ years 199
## 5 Ed justice Less than a year 6
## 6 Ed justice 1-2 years 40
## 7 Ed justice 3-4 years 48
## 8 Ed justice 5+ years 161
## 9 Individualized Less than a year 2
## 10 Individualized 1-2 years 9
## 11 Individualized 3-4 years 19
## 12 Individualized 5+ years 59
## 13 None Less than a year 6
## 14 None 1-2 years 21
## 15 None 3-4 years 49
## 16 None 5+ years 111
## 17 Postsecondary Less than a year 2
## 18 Postsecondary 1-2 years 17
## 19 Postsecondary 3-4 years 18
## 20 Postsecondary 5+ years 76Note, cluster counts are different. What is the best way to represent these cluster selections by time given these differences?
implementation_with_color %>%
group_by(cluster) %>%
summarise(count = n_distinct(practice))## # A tibble: 5 × 2
## cluster count
## <chr> <int>
## 1 Deeper learning 12
## 2 Ed justice 19
## 3 Individualized 9
## 4 None 24
## 5 Postsecondary 9core_prac %>%
filter(times_selected >0) %>%
mutate(core_practice = gsub("core_", "practices_", core_practice)) %>%
left_join(., clean_labels, by = c("core_practice" = "variable")) %>%
left_join(., old_clusters, by = c("core_practice" = "var")) %>%
group_by(cluster, year) %>%
summarise(n = n()) %>%
filter(!is.na(cluster)) %>%
ggplot(aes(fill = cluster)) +
geom_col(aes(year, n)) +
facet_grid(~cluster) +
scale_y_continuous(expand = c(0,0)) +
theme(panel.grid.major.x = element_blank(),
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1, size = 7)) +
scale_fill_manual(values = transcend_cols2) +
labs(title = "Cluster Selection by Year",
x = "",
y = "")
implementation_with_color %>%
group_by(cluster, time) %>%
summarise(total = sum(N)) %>%
ggplot(aes(reorder(cluster, total), total, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Practice Clusters by Time Implemented",
x = "",
y = "") +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)
implementation_with_color %>%
group_by(cluster, time) %>%
summarise(total = sum(N)) %>%
filter(cluster != "None") %>%
ggplot() +
geom_col(aes(x = reorder(cluster, total), y = total, fill = time)) +
# geom_text(aes(x = reorder(cluster, total), y = total, label = total), position = "fill") +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Practice Clusters by Time Implemented",
x = "",
y = "") +
theme(legend.position = "bottom",
legend.direction = "horizontal",
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
legend.title = element_blank(),
axis.text.y = element_markdown()
) 